home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / gfaxpert.lzh / GFAXPERT.LIB / SCREEN.LST < prev    next >
File List  |  1986-10-19  |  8KB  |  275 lines
  1. ' ******************
  2. ' *** SCREEN.LST ***
  3. ' ******************
  4. '
  5. DEFWRD "a-z"
  6. '
  7. > PROCEDURE initio.logical.screen
  8.   ' *** install second screen as logical screen
  9.   ' *** if necessary, move original screen to logical screen (last line)
  10.   ' *** all graphical commands go to logical screen (screen.2)
  11.   ' *** PRINT always goes to physical screen (monitor) !!
  12.   ' *** uses Standard Global physbase%
  13.   ' *** global :   SCREEN.1%   SCREEN.2%
  14.   DIM screen.2|(32256)                ! reserve room for second screen
  15.   screen.2%=VARPTR(screen.2|(0))
  16.   screen.2%=screen.2%+256-(screen.2% MOD 256) ! screen on 256-byte border
  17.   screen.1%=physbase%
  18.   ~XBIOS(5,L:screen.2%,L:-1,-1)  ! invisible screen.2 is now active
  19.   ' BMOVE screen.1%,screen.2%,32000  ! move original screen to screen.2
  20. RETURN
  21. ' ***
  22. > PROCEDURE swap.screen
  23.   ' *** call this Procedure if drawing-screen is finished
  24.   ' *** physical and logical screen are swapped
  25.   ' *** continue with drawing on the invisible logical screen
  26.   ' *** if necessary, move fresh screen to new logical screen (last line)
  27.   SWAP screen.1%,screen.2%
  28.   VSYNC                                       ! necessary to avoid flashes
  29.   ~XBIOS(5,L:screen.2%,L:screen.1%,-1)    ! swap the screens
  30.   ' BMOVE screen.1%,screen.2%,32000  ! move fresh screen to screen.2
  31. RETURN
  32. ' ***
  33. > PROCEDURE restore.physical.screen
  34.   ' *** restore default situation (logical screen = physical screen)
  35.   ~XBIOS(5,L:physbase%,L:physbase%,-1)
  36. RETURN
  37. ' **********
  38. '
  39. > PROCEDURE screen.black.out
  40.   ' *** clear screen with shrinking black rectangle
  41.   ' *** uses Standard Globals
  42.   LOCAL i
  43.   COLOR black
  44.   FOR i=0 TO scrn.y.max/2
  45.     BOX i,i,scrn.x.max-i,scrn.y.max-i
  46.   NEXT i
  47.   COLOR white
  48.   FOR i=scrn.y.max/2 DOWNTO 0
  49.     BOX i,i,scrn.x.max-i,scrn.y.max-i
  50.   NEXT i
  51.   COLOR black
  52. RETURN
  53. ' **********
  54. '
  55. > PROCEDURE screen.dimmer
  56.   ' *** dimm screen (during some action)
  57.   ' *** High resolution only
  58.   ' *** global :   DIMMER.SCREEN$   DIMMER.SWITCH!
  59.   IF dimmer.switch!
  60.     SPUT dimmer.screen$
  61.     ' CLR dimmer.screen$        ! if you need space
  62.     dimmer.switch!=FALSE
  63.   ELSE
  64.     SGET dimmer.screen$
  65.     GRAPHMODE 4
  66.     DEFFILL 1,2,4
  67.     PBOX 0,0,639,399
  68.     dimmer.switch!=TRUE
  69.   ENDIF
  70. RETURN
  71. ' **********
  72. '
  73. > PROCEDURE screen.black.lines
  74.   ' *** clear screen with lines
  75.   ' *** uses Standard Globals
  76.   LOCAL i,j
  77.   COLOR black
  78.   FOR j=0 TO 9
  79.     FOR i=j TO SUCC(scrn.y.max) STEP 10
  80.       LINE 0,i,scrn.x.max,i
  81.     NEXT i
  82.     PAUSE 1
  83.   NEXT j
  84.   CLS
  85. RETURN
  86. ' **********
  87. '
  88. > PROCEDURE screen.black.scroll
  89.   ' *** clear screen with upwards scrolling black rectangle
  90.   ' *** uses Standard Globals
  91.   LOCAL i
  92.   COLOR black
  93.   FOR i=scrn.y.max DOWNTO 0
  94.     LINE 0,i,scrn.x.max,i
  95.   NEXT i
  96.   COLOR white
  97.   PAUSE 10
  98.   FOR i=scrn.y.max DOWNTO 0
  99.     LINE 0,i,scrn.x.max,i
  100.   NEXT i
  101.   COLOR black
  102. RETURN
  103. ' **********
  104. '
  105. > PROCEDURE invert.block(x1,y1,x2,y2,color)
  106.   ' *** invert block (e.g. to acknowledge user's choice)
  107.   ' *** call Procedure second time (with same parameters) to restore block
  108.   GRAPHMODE 3
  109.   DEFFILL color,1
  110.   BOUNDARY 0
  111.   PBOX x1,y1,x2,y2
  112.   BOUNDARY 1
  113.   GRAPHMODE 1
  114. RETURN
  115. ' **********
  116. '
  117. > PROCEDURE block.dimmer(x1,y1,x2,y2,color)
  118.   ' *** dimm block (e.g. for selection that is temporarily not available)
  119.   ' *** call Procedure second time (with same parameters) to restore block
  120.   GRAPHMODE 3
  121.   DEFFILL color,2,2
  122.   BOUNDARY 0
  123.   PBOX x1,y1,x2,y2
  124.   BOUNDARY 1
  125.   GRAPHMODE 1
  126. RETURN
  127. ' **********
  128. '
  129. > PROCEDURE show.degas(degas$)
  130.   ' *** put Degas-picture on screen (and use picture-palette)
  131.   ' *** uses Standard Globals
  132.   ' *** global :   SHOW.DEGAS!
  133.   LOCAL r$,degas.picture$,degas.picture%,degas.palette$,degas.palette%
  134.   r$=UPPER$(RIGHT$(degas$,3))
  135.   IF (high.res! AND r$="PI3") OR (med.res! AND r$="PI2") OR (low.res! AND r$="PI1")
  136.     degas.picture$=SPACE$(32000)
  137.     degas.picture%=VARPTR(degas.picture$)
  138.     degas.palette$=SPACE$(32)
  139.     degas.palette%=VARPTR(degas.palette$)
  140.     OPEN "I",#90,degas$
  141.     SEEK #90,2
  142.     BGET #90,degas.palette%,32            ! load palette of picture
  143.     SEEK #90,34
  144.     BGET #90,degas.picture%,32000         ! load actual picture
  145.     CLOSE #90
  146.     ~XBIOS(6,L:degas.palette%)            ! change palette
  147.     SPUT degas.picture$                   ! show the picture
  148.     show.degas!=TRUE                      ! success
  149.   ELSE
  150.     show.degas!=FALSE                     ! failure
  151.   ENDIF
  152. RETURN
  153. ' **********
  154. '
  155. > PROCEDURE save.degas(file$)
  156.   ' *** save current screen as Degas-picture
  157.   ' *** use correct extension (PI1=Low, PI2=Medium, PI3=High)
  158.   ' *** uses Standard Globals and Standard Procedure Exit
  159.   LOCAL screen$,degas.palette$,n%,degas$,res$,m$,k
  160.   SGET screen$
  161.   file$=UPPER$(file$)
  162.   degas.palette$=""
  163.   FOR n%=0 TO 15
  164.     degas.palette$=degas.palette$+MKI$(XBIOS(7,n%,-1))
  165.   NEXT n%
  166.   IF high.res! AND RIGHT$(file$,3)="PI3"
  167.     res$=MKI$(2)
  168.   ELSE IF med.res! AND RIGHT$(file$,3)="PI2"
  169.     res$=MKI$(1)
  170.   ELSE IF low.res! AND RIGHT$(file$,3)="PI1"
  171.     res$=MKI$(0)
  172.   ELSE
  173.     m$="wrong extension|for Degas|in this|resolution"
  174.     ALERT 3,m$,1," OK ",k
  175.     @exit
  176.   ENDIF
  177.   degas$=res$+degas.palette$+screen$
  178.   BSAVE file$,VARPTR(degas$),LEN(degas$)
  179. RETURN
  180. ' **********
  181. '
  182. > PROCEDURE show.comp.degas(degas.file$)
  183.   ' *** put compressed Degas-picture on screen (and use picture-palette)
  184.   ' *** original routine by Jim Kent
  185.   ' *** uses Standard Globals
  186.   ' *** global :   SHOW.COMP.DEGAS!
  187.   LOCAL r$,temp$,p%,temp2$,b%,i%,k%,p%,q%,scr%,screen%
  188.   show.comp.degas!=FALSE
  189.   '
  190.   ' *** load UNPAC.INL (60 bytes) here
  191.   INLINE unpac%,60
  192.   '
  193.   ' *** load UNRAV.INL (40 bytes) here
  194.   INLINE unrav%,40
  195.   '
  196.   IF degas.file$<>""
  197.     r$=UPPER$(RIGHT$(degas.file$,3))
  198.     IF EXIST(degas.file$) AND MID$(r$,2,1)="C"
  199.       temp$=SPACE$(32760)
  200.       p%=VARPTR(temp$)
  201.       BLOAD degas.file$,p%
  202.       screen%=physbase%          ! picture appears on screen while decompressing
  203.       temp2$=SPACE$(40)
  204.       b%=VARPTR(temp2$)
  205.       p%=p%+2
  206.       FOR i%=0 TO 15
  207.         SETCOLOR i%,DPEEK(p%)
  208.         ADD p%,2
  209.       NEXT i%
  210.       IF high.res! AND r$="PC3"
  211.         FOR k%=1 TO 400
  212.           scr%=screen%
  213.           p%=C:unpac%(L:p%,L:b%,80)
  214.           q%=C:unrav%(L:b%,L:scr%,80,2)
  215.           ADD screen%,80
  216.         NEXT k%
  217.         show.comp.degas!=TRUE
  218.       ELSE IF med.res! AND r$="PC2"
  219.         FOR k%=1 TO 200
  220.           scr%=screen%
  221.           FOR c%=1 TO 2
  222.             p%=C:unpac%(L:p%,L:b%,80)
  223.             q%=C:unrav%(L:b%,L:scr%,80,4)
  224.             ADD scr%,2
  225.           NEXT c%
  226.           ADD screen%,160
  227.         NEXT k%
  228.         show.comp.degas!=TRUE
  229.       ELSE IF low.res! AND r$="PC1"
  230.         FOR k%=1 TO 200
  231.           scr%=screen%
  232.           FOR c%=1 TO 4
  233.             p%=C:unpac%(L:p%,L:b%,40)
  234.             q%=C:unrav%(L:b%,L:scr%,40,8)
  235.             ADD scr%,2
  236.           NEXT c%
  237.           ADD screen%,160
  238.         NEXT k%
  239.         show.comp.degas!=TRUE
  240.       ENDIF
  241.     ELSE
  242.       ALERT 1,"Can't find|compressed|Degas-file|"+degas.file$,1,"EDIT",button
  243.       EDIT
  244.     ENDIF
  245.   ENDIF
  246. RETURN
  247. ' **********
  248. '
  249. > PROCEDURE blend(scrn.adr%,mode%,delay)
  250.   ' *** fade-over of current screen with other screen (e.g. picture)
  251.   ' *** mode% determines effect (= stepsize; ≥ 1, ≤ 32000)
  252.   ' *** try mode% 1,7,8 or 9
  253.   ' *** delay determines time (≥ 0)
  254.   '
  255.   ' *** load BLEND.INL (68 bytes) here
  256.   INLINE blend%,68
  257.   '
  258.   VOID C:blend%(L:scrn.adr%,L:mode%,delay)
  259. RETURN
  260. ' **********
  261. '
  262. > PROCEDURE full.fill(fill$)
  263.   ' *** fill screen extremely fast with Fill-pattern fill$
  264.   ' *** use Procedure Initio.fill or Initio.high.fill1 to create fill$
  265.   ' *** High resolution only
  266.   LOCAL fill%
  267.   fill%=V:fill$
  268.   CLS
  269.   ACLIP 1,0,0,639,399
  270.   ARECT 0,0,639,399,1,0,fill%,15
  271.   ACLIP 0,0,0,639,399
  272. RETURN
  273. ' **********
  274. '
  275.